home *** CD-ROM | disk | FTP | other *** search
/ Ian & Stuart's Australian Mac: Not for Sale / Another.not.for.sale (Australia).iso / fade into you / being there / Services / Gopher / gopher.moo < prev    next >
Text File  |  1993-07-16  |  50KB  |  1,437 lines
  1. gopher.moo    Thu July 15, 1993, 9:31PM, Version 1.0
  2.  
  3. Copyright (c) 1992, 1993, Larry Masinter, Erik Ostrom
  4. All Rights Reserved
  5.  
  6. Permission granted to use this software for non-commercial purposes;
  7. we'd like to be notified of any enhancements, applications, or
  8. bug-fixes in the software.
  9.  
  10. This is a general MOO interface to Gopher. To use it, you need a MOO
  11. server. The MOO software is available from
  12. <ftp://parcftp.xerox.com/pub/MOO/>. In addition, you need some minor
  13. changes to the MOO server, so that does not change tabs into spaces on
  14. input, and to have open_network_connection enabled.
  15.  
  16.  
  17. ================================================================
  18. Be sure you're running the server patch (describe dbelow) first!
  19. This is a dump of $gopher, the gopher slate, and $network
  20.  
  21. Create three objects
  22.     @create #1 named Gopher utilities
  23.     @create $thing named Generic Gopher Slate
  24.     @create #1 named Network Utilities
  25.  
  26. edit the following script to replace these numbers numbers with the
  27. numbers of the three new ones, and then execute it.
  28.  
  29.   #11111    == number of Gopher utilities
  30.   #22222    == number of Generic Gopher Slate
  31.   #33333    == number of Network Utilities
  32.  
  33. (Note the '@prop #0.gopher #11111' and '@prop #0.network #33333' commands,
  34. which set $gopher and $network respectively. You may need to
  35. @rmprop #0.network to remove the bogus LambdaCore version.)
  36.  
  37. Fix $network.postmaster, .site, .port, .MOO_name, .large_domains.
  38. $network.large_domains = list of network domains such that FOO.name.edu
  39.             should be considered a separate host than
  40.             BAR.name.edu.
  41.  
  42. Using the Generic slate, use 'goto host port on generic slate' and
  43. 'remember on slate' to set up the default 'top level' menu of new
  44. gopher slates.
  45.  
  46.  
  47. WARNING: The script contains tab characters. Be sure they don't get turned into spaces.
  48.  
  49. ================================================================
  50. Change log:
  51.  
  52. Version 0.1  -- initial release
  53. Version 0.2  -- use $network:open instead of raw o_n_c
  54.             validity check on host names
  55.         limit on retrievals
  56.         add (some) documentation to $gopher.room verbs
  57.         gopher rooms have a remembered set
  58.         add CSO phone book entries
  59.         use .desclines property instead of :description
  60.         (exam won't spam).
  61.         add gopher lists
  62. Version 0.3:    change gopher room to portable slate
  63.         subsumes notes
  64.         differential cache timeout (shorter for failures)
  65.         
  66. Version 0.4:    Include $network in release (Thanks to unattributed JHM programmers)
  67.         Add 'controlled' state on slate.
  68.                 Slates show headers when they update if watcher isn't controller.
  69.  
  70. Version 0.5:    clean up the $network dump some
  71.  
  72. Version 0.6:
  73. Version 0.7:    very minor patches: more general mailing,
  74.                 hopefully better installation instructions
  75.  
  76. Version 1.0:    after port to LambdaMOO, simplify $network, $gopher
  77.  
  78.  
  79. ================================================================
  80. The patch to allow tabs is in: net_multi.c
  81. (not sure if a similar change is necessary in net_single.c)
  82. ***************
  83. *** 157,161 ****
  84.           stream_add_char(s, c);
  85.           else if (c == '\t')
  86. !         stream_add_char(s, '\t');
  87.           else if (c == proto.eol_in_char)
  88.           server_receive_line(h->shandle, reset_stream(s));
  89. --- 157,161 ----
  90.           stream_add_char(s, c);
  91.           else if (c == '\t')
  92. !         stream_add_char(s, ' ');
  93.           else if (c == proto.eol_in_char)
  94.           server_receive_line(h->shandle, reset_stream(s));
  95. ================================================================
  96. @prop #0.gopher #11111 "r"
  97. @prop #11111."cache_requests" {} r
  98. @prop #11111."cache_times" {} r
  99. @prop #11111."cache_values" {} r
  100. @prop #11111."limit" 2000 rc
  101. @prop #11111."cache_timeout" 900 r
  102. ;#11111.("description") = {"An interface to Gopher internet services.", "Copyright (c) 1992,1993 Grump,JoeFeedback@LambdaMOO.", "", "This object contains just the raw verbs for getting data from gopher servers and parsing the results. Look at #50122 (Generic Gopher Slate) for one example of a user interface. ", "", ":get(site, port, selection)", "  Get data from gopher server: returns a list of strings, or an error if it couldn't connect. Results are cached.", "", ":get_now(site, port, selection)", "  Like $gopher:get, but bypass the cache (used by $gopher:get).", "", ":show_text(who, start, end, site, port, selection)", "  Requires wiz-perms to call.", "  like who:notify_lines($gopher:get(..node..)[start..end])", "", ":clear_cache()", "  Erase the gopher cache.", "", ":parse(string)", "  Takes a directory line as returned by $gopher:get, and return a list", "  {host, port, selector, label}", "   host, port, and selector are what you send to :get.", "  label is a string, where the first character is the type code.", "", ":type(char)", "   returns the name of the gopher type indicated by the character, e.g.", "   $gopher:type(\"I\") => \"image\"", ""}
  103. @verb #11111:"get_now" this none this rx
  104. @program #11111:get_now
  105. "Usage:  get_now(site, port, message)";
  106. "Returns a list of strings, or an error if we couldn't connect.";
  107. host = args[1];
  108. port = args[2];
  109. if (!this:trusted(caller_perms()))
  110.   return E_PERM;
  111. elseif ((!match(host, $network.valid_host_regexp)) && (!match(host, "[0-9]+%.[0-9]+%.[0-9]+%.[0-9]+")))
  112.   "allow either welformed internet hosts or explicit IP addresses.";
  113.   return E_INVARG;
  114. elseif (((port != 70) && (port != 80)) && (port < 100))
  115.   "disallow connections to low number ports; necessary?";
  116.   return E_INVARG;
  117. endif
  118. opentime = time();
  119. con = $network:open(args[1], args[2]);
  120. opentime = (time() - opentime);
  121. if (typeof(con) == ERR)
  122.   return con;
  123. endif
  124. read(con);
  125. "eliminate blank line";
  126. notify(con, args[3]);
  127. results = {};
  128. count = this.limit;
  129. "perhaps this isn't necessary, but if a gopher source is slowly spewing things, perhaps we don't want to hang forever -- perhaps this should just fork a process to close the connection instead?";
  130. now = time();
  131. timeout = 30;
  132. end = "^%.$";
  133. if ((length(args) == 4) && (args[4][1] == "2"))
  134.   end = "^[2-9]";
  135. endif
  136. while ((((typeof(string = read(con)) == STR) && (!match(string, end))) && ((count = (count - 1)) > 0)) && ((now + timeout) > (now = time())))
  137.   if (string && (string[1] == "."))
  138.     string = string[2..length(string)];
  139.   endif
  140.   results = {@results, string};
  141. endwhile
  142. $network:close(con);
  143. if (opentime > 0)
  144.   "This is to keep repeated calls to $network:open to 'slow responding hosts' from totally spamming.";
  145.   suspend(0);
  146. endif
  147. return results;
  148. .
  149.  
  150. @verb #11111:"parse" this none this
  151. @program #11111:parse
  152. "parse gopher result line:";
  153. "return {host, port, tag, label}";
  154. "host/port/tag are what you send to the gopher server to get that line";
  155. "label is <type>/human readable entry";
  156. string = args[1];
  157. tab = index(string, "    ");
  158. label = string[1..tab - 1];
  159. string = string[tab + 1..length(string)];
  160. tab = index(string, "    ");
  161. tag = string[1..tab - 1];
  162. string = string[tab + 1..length(string)];
  163. tab = index(string, "    ");
  164. host = string[1..tab - 1];
  165. string = string[tab + 1..length(string)];
  166. tab = index(string, "    ");
  167. port = tonum(tab ? string[1..tab - 1] | string);
  168. return {host, port, tag, label};
  169. "ignore extra material after port, if any";
  170. .
  171.  
  172. @verb #11111:"show_text" this none this rx
  173. @program #11111:show_text
  174. "$gopher:show_text(who, start, end, ..node..)";
  175. "like who:notify_lines($gopher:get(..node..)[start..end]), but pipelined";
  176. if (!caller_perms().wizard)
  177.   return E_PERM;
  178. endif
  179. who = args[1];
  180. start = args[2];
  181. end = args[3];
  182. args = args[4..length(args)];
  183. con = $network:open(args[1], args[2]);
  184. if (typeof(con) == ERR)
  185.   player:tell("Sorry, can't get this information now.");
  186.   return;
  187. endif
  188. notify(con, args[3]);
  189. read(con);
  190. "initial blank line";
  191. line = 0;
  192. sent = 0;
  193. end = (end || this.limit);
  194. while (((string = read(con)) != ".") && (typeof(string) == STR))
  195.   line = (line + 1);
  196.   if ((line >= start) && ((!end) || (line <= end)))
  197.     sent = (sent + 1);
  198.     if (valid(who))
  199.       if (string && (string[1] == "."))
  200.         string = string[2..length(string)];
  201.       endif
  202.       who:notify(string);
  203.     else
  204.       notify(who, string);
  205.     endif
  206.   endif
  207. endwhile
  208. $network:close(con);
  209. return sent;
  210. .
  211.  
  212. @verb #11111:"type" this none this
  213. @program #11111:type
  214. type = args[1];
  215. if (type == "1")
  216.   return "menu";
  217. elseif (type == "?")
  218.   return "menu?";
  219. elseif (type == "0")
  220.   return "text";
  221. elseif (type == "7")
  222.   return "search";
  223. elseif (type == "9")
  224.   return "binary";
  225. elseif (type == "2")
  226.   return "phone directory";
  227. elseif (type == "4")
  228.   return "binhex";
  229. elseif (type == "8")
  230.   return "telnet";
  231. elseif (type == "I")
  232.   return "image";
  233. elseif (type == " ")
  234.   "not actually gopher protocol: used by 'goto'";
  235.   return "";
  236. else
  237.   return "unknown";
  238. endif
  239. "not done, need to fill out";
  240. .
  241.  
  242. @verb #11111:"summary" this none this
  243. @program #11111:summary
  244. "return a 'nice' string showing the information in a gopher node";
  245. if (typeof(parse = args[1]) == STR)
  246.   parse = this:parse(parse);
  247. endif
  248. if (parse[1] == "!")
  249.   return {"[remembered set]", "", ""};
  250. endif
  251. if (length(parse) > 3)
  252.   label = parse[4];
  253.   if (label)
  254.     type = $gopher:type(label[1]);
  255.     label = label[2..length(label)];
  256.     if (type == "menu")
  257.     elseif (type == "search")
  258.       label = ((("<" + parse[3][rindex(parse[3], "    ") + 1..length(parse[3])]) + "> ") + label);
  259.     else
  260.       label = ((type + ": ") + label);
  261.     endif
  262.   else
  263.     label = "(top)";
  264.   endif
  265. else
  266.   label = (parse[3] + " (top)");
  267. endif
  268. port = "";
  269. if (parse[2] != 70)
  270.   port = tostr(" ", parse[2]);
  271. endif
  272. return {tostr("[", parse[1], port, "]"), label, parse[3]};
  273. .
  274.  
  275. @verb #11111:"get" this none this
  276. @program #11111:get
  277. "Usage: get(site, port, selection)";
  278. "returns a list of strings, or an error if it couldn't connect. Results are cached.";
  279. request = args[1..3];
  280. while ((index = (request in this.cache_requests)) && (this.cache_times[index] > time()))
  281.   if (typeof(result = this.cache_values[index]) != NUM)
  282.     return result;
  283.   endif
  284.   if ($code_utils:task_valid(result))
  285.     "spin, let other process getting same data win, or timeout";
  286.     suspend(1);
  287.   else
  288.     "well, other process crashed, or terminated, or whatever.";
  289.     this.cache_times[index] = 0;
  290.   endif
  291. endwhile
  292. if (!this:trusted(caller_perms()))
  293.   return E_PERM;
  294. endif
  295. while (this.cache_times && (this.cache_times[1] < time()))
  296.   $command_utils:suspend_if_needed(0);
  297.   this.cache_times = listdelete(this.cache_times, 1);
  298.   this.cache_values = listdelete(this.cache_values, 1);
  299.   this.cache_requests = listdelete(this.cache_requests, 1);
  300.   "caution: don't want to suspend between test and removal";
  301. endwhile
  302. $command_utils:suspend_if_needed(0);
  303. this:cache_entry(@request);
  304. value = this:get_now(@args);
  305. $command_utils:suspend_if_needed(0);
  306. index = this:cache_entry(@request);
  307. this.cache_times[index] = (time() + ((typeof(value) == ERR) ? 120 | 1800));
  308. this.cache_values[index] = value;
  309. return value;
  310. .
  311.  
  312. @verb #11111:"clear_cache" this none this
  313. @program #11111:clear_cache
  314. if (!this:trusted(caller_perms()))
  315.   return E_PERM;
  316. endif
  317. if (!args)
  318.   this.cache_values = (this.cache_times = (this.cache_requests = {}));
  319. elseif (index = (args[1..3] in this.cache_requests))
  320.   this.cache_requests = listdelete(this.cache_requests, index);
  321.   this.cache_times = listdelete(this.cache_times, index);
  322.   this.cache_values = listdelete(this.cache_values, index);
  323. endif
  324. .
  325.  
  326. @verb #11111:"unparse" this none this
  327. @program #11111:unparse
  328. "unparse(host, port, tag, label) => string";
  329. host = args[1];
  330. port = args[2];
  331. tag = args[3];
  332. label = args[4];
  333. if (tab = index(tag, "    "))
  334.   "remove search terms from search nodes";
  335.   tag = tag[1..tab - 1];
  336. endif
  337. return tostr(label, "    ", tag, "    ", host, "    ", port);
  338. .
  339.  
  340. @verb #11111:"interpret_error" this none this
  341. @program #11111:interpret_error
  342. "return an explanation for a 'false' $gopher:get result";
  343. value = args[1];
  344. if (value == E_INVARG)
  345.   return "That gopher server is not reachable or is not responding.";
  346. elseif (value == E_QUOTA)
  347.   return "Gopher connections cannot be made at this time because of system resource limitations!";
  348. elseif (typeof(value) == ERR)
  349.   return tostr("The gopher request results in an error: ", value);
  350. else
  351.   return "The gopher request has no results.";
  352. endif
  353. .
  354.  
  355. @verb #11111:"trusted" this none this
  356. @program #11111:trusted
  357. "default -- gopher trusts everybody";
  358. return 1;
  359. .
  360.  
  361. @verb #11111:"_textp" this none this
  362. @program #11111:_textp
  363. "_textp(parsed node)";
  364. "Return true iff the parsed info points to a text node.";
  365. return index("02", args[1][4][1]);
  366. .
  367.  
  368. @verb #11111:"_mail_text" this none this
  369. @program #11111:_mail_text
  370. "_mail_text(parsed node)";
  371. "Return the text to be mailed out for the given node.";
  372. where = args[1];
  373. if (this:_textp(where))
  374.   return $gopher:get(@where);
  375. else
  376.   text = {};
  377.   for x in ($gopher:get(@where))
  378.     parse = $gopher:parse(x);
  379.     sel = parse[4];
  380.     text = {@text, "Type=" + sel[1], "Name=" + sel[2..length(sel)], "Path=" + parse[3], "Host=" + parse[1], "Port=" + tostr(parse[2]), "#"};
  381.   endfor
  382.   return text;
  383. endif
  384. .
  385.  
  386. @verb #11111:"init_for_core" this none this
  387. @program $gopher:init_for_core
  388. if (caller_perms().wizard)
  389.    this:clear_cache();
  390.    pass(@args);
  391. endif
  392. .
  393. @verb #11111:"display_cache" this none none rxd
  394. @program #11111:display_cache
  395. "Just for debugging -- shows what's in the gopher cache";
  396. req = this.cache_requests;
  397. tim = this.cache_times;
  398. val = this.cache_values;
  399. "save values in case cache changes while printing";
  400. player:tell("size -- expires -- host (port) ------ selector ------------");
  401. for i in [1..length(req)]
  402.   re = req[i];
  403.   host = $string_utils:left(re[1] + ((re[2] == 70) ? "" | tostr(" (", re[2], ")")), 24);
  404.   expires = $string_utils:right($time_utils:dhms(tim[i] - time()), 8);
  405.   va = val[i];
  406.   if (typeof(va) == LIST)
  407.     va = length(va);
  408.   elseif (typeof(va) == ERR)
  409.     va = $error:name(va);
  410.   else
  411.     va = tostr(va);
  412.   endif
  413.   selector = re[3];
  414.   if (length(selector) > 40)
  415.     selector = ("..." + selector[length(selector) - 37..length(selector)]);
  416.   endif
  417.   player:tell($string_utils:right(va, 8), expires, " ", host, selector);
  418. endfor
  419. player:tell("--- end cache display -------------------------------------");
  420. .
  421.  
  422. @verb #11111:"get_cache" this none this
  423. @program #11111:get_cache
  424. "Usage: get_cache(site, port, selection)";
  425. "return current cache";
  426. request = args[1..3];
  427. if (index = (request in this.cache_requests))
  428.   if (this.cache_times[index] > now)
  429.     return this.cache_values[index];
  430.   endif
  431. endif
  432. return 0;
  433. .
  434.  
  435. @verb #11111:"cache_entry" this none this
  436. @program #11111:cache_entry
  437. if (index = (args in this.cache_requests))
  438.   return index;
  439. else
  440.   this.cache_times = {@this.cache_times, time() + 240};
  441.   this.cache_values = {@this.cache_values, task_id()};
  442.   this.cache_requests = {@this.cache_requests, args};
  443.   return length(this.cache_requests);
  444. endif
  445. .
  446.  
  447. "***finished loading $gopher***
  448. @prop #22222."value" {} r
  449. @prop #22222."stack" {} r
  450. @prop #22222."busy" 0 r
  451. @prop #22222."remembered" {} r
  452. @prop #22222."desclines" {} r
  453. @prop #22222."seen" {} r
  454. @prop #22222."length" 20 rc
  455. @prop #22222."help_msg" {} rc
  456. ;#22222.("help_msg") = {"Moving around:", " pick <item> on slate", "    select the given menu item (either a number or partial name).", "    If it is a text item, it will show it to you.", " <number> on slate", "    e.g., 12 on slate. You can omit `pick' when chosing items", "    by their number.", " back slate [for n]", "    go back up a level; with n supplied, goes back n levels", " reset slate", "    reset slate to the default list of `remember'-ed nodes", " goto host [port [path]] on slate", "    make a direct jump to a specified host. Please be careful --", "    at the moment this slows everyone down if the host isn't valid.", "", "Controlling noise:", " ignore slate", "    stop listening when other people fiddle with the slate", " watch slate", "    start watching while other people fiddle with the slate", " show slate to person", "    show the contents of the slate to someone even if they're not watching", "", "Bookmarks:", " remember [<item>] on slate", "    adds item to the default of nodes", "    will prompt you for title", " remember on slate", "    remembers the current menu choice rather than any ", "    particular item", " forget <item> on slate", "    (only when looking at the default list)", "    deletes the given item", "", "In long menus and text:", " next [<n>] on slate", " prev [<n>] on slate", "    move you forward/backward in the set of visible menu items.", "    You can give a `number of pages' to move forward.", " read slate", "    show you the entire contents of the slate", "", "Miscellaneous:", " stack slate", "    show stack, where `back' will go", " details <item> on slate", "    show host, port number, and selection string for a given item.    ", " mailme slate", "    if you have a valid registration address: send mail with the", "    slate contents to your email address.", "", "When you first make a gopher slate, you will need to use `goto'", "and then `remember' to set up the default list of nodes."}
  457. @prop #22222."locked" 0 r
  458. @prop #22222."ignoring" {} r
  459. @prop #22222."watching" {} r
  460. @prop #22222."controlled" #-1 r
  461. @prop #22222."work_with_msg" "%N %<starts> to work with %d." rc
  462. ;#22222.("description") = "A laptop size computer, with various controls on it."
  463.  
  464. @verb #22222:"p*ick" any on this rxd
  465. @program #22222:pick
  466. "pick <entry> on slate";
  467. "  entry is either a line number or an initial substring of a line description";
  468. "  select that entry: if it is a menu, go to that node. If it is a search,";
  469. "  asks you for the search term & does the search.";
  470. "  Some kinds of nodes are not implemented.";
  471. if (this:_textp() || (!(this.stack || this.remembered)))
  472.   return player:tell("There's nothing to pick.");
  473. endif
  474. if (this:busy("picking"))
  475.   return;
  476. endif
  477. if (!(which = this:match_choice(dobjstr)))
  478.   "match_choice took care of it.";
  479.   this:busy(0);
  480.   return;
  481. endif
  482. if ((tostr(tonum(dobjstr)) == dobjstr) && (!({player, @this:_place()} in this.seen)))
  483.   player:tell($string_utils:pronoun_sub("Oooops, perhaps you should look at the %t first."));
  484.   this:busy(0);
  485.   return;
  486. endif
  487. parse = $gopher:parse(this.value[which]);
  488. desc = this.desclines[which];
  489. this:announce_op("%N %<picks> '", desc, "' on the %t.");
  490. this:do_pick(@parse);
  491. return;
  492. .
  493.  
  494. @verb #22222:"reset" this none none rxd
  495. @program #22222:reset
  496. "reset slate";
  497. "  reset the slate to its set of 'remembered' selections";
  498. if (why = this:is_locked(player))
  499.   return player:tell($string_utils:pronoun_sub("Sorry, %t seems to be "), why, ".");
  500. elseif (this:busy("resetting"))
  501.   return;
  502. endif
  503. this:announce_op("%N %<resets> the %t.");
  504. this.seen = {};
  505. this:set_pointer();
  506. this:busy(0);
  507. .
  508.  
  509. @verb #22222:"pop back" any any any rxd
  510. @program #22222:pop
  511. "back this [by <n>]";
  512. "  move back up the gopher stack to the previous menu";
  513. "  or previous N menus.";
  514. n = 1;
  515. if (iobjstr && (!(iobjstr == tostr(n = tonum(iobjstr)))))
  516.   return player:tell("Sorry, '", iobjstr, "' doesn't look like a number.");
  517. endif
  518. if (length(this.stack) < n)
  519.   player:tell("Sorry, there aren't ", n, " levels to go back.");
  520.   return;
  521. endif
  522. if (this:busy("going back"))
  523.   return;
  524. endif
  525. this:announce_op("%N %<goes> back up ", (n == 1) ? "a level" | tostr(n, " levels"), " on the %t.");
  526. this:set_pointer(@this.stack[n + 1..length(this.stack)]);
  527. this:busy(0);
  528. .
  529.  
  530. @verb #22222:"location_string" this none this rx
  531. @program #22222:location_string
  532. "location_string([location])";
  533. "A nice-looking version of the location provided, or current location.";
  534. loc = ((args && args[1]) || this.stack[1]);
  535. where = loc[1];
  536. if (st = loc[4])
  537.   "human readable string";
  538.   return ((st[2..length(st)] + " (from ") + where) + ")";
  539.   return (where + ": ") + st[2..length(st)];
  540. endif
  541. if (loc[3])
  542.   return ((loc[3] + " (from ") + where) + ")";
  543.   return (where + ": ") + loc[3];
  544. endif
  545. return where;
  546. .
  547.  
  548. @verb #22222:"stack" this none none rxd
  549. @program #22222:stack
  550. "stack slate";
  551. "  show a summary of the gopher stack";
  552. max = 0;
  553. if (!this.stack)
  554.   return player:tell($string_utils:pronoun_sub("%T is at the top level."));
  555. endif
  556. for x in (this.stack)
  557.   max = max(max, length(x[1]));
  558. endfor
  559. max = (max + 6);
  560. for x in ($list_utils:reverse(this.stack))
  561.   summary = $gopher:summary(x);
  562.   player:tell($string_utils:left(summary[1], max), " ", summary[2]);
  563. endfor
  564. .
  565.  
  566. @verb #22222:"busy" this none this
  567. @program #22222:busy
  568. "interlock for caching -- mark cache busy or clear; return true of interlock failed";
  569. if (args[1])
  570.   if ((args[1] != "reading") && (why = this:is_locked(player)))
  571.     player:tell($string_utils:pronoun_sub("Sorry, %t seems to be "), why, ".");
  572.     return 1;
  573.   endif
  574.   "make player running this watch it.";
  575.   this.watching = setadd(this.watching, player);
  576.   "set busy";
  577.   if (this.busy && (this.busy[1] > time()))
  578.     player:tell("***Sorry, ", this.name, " is busy ", this.busy[2], " for ", this.busy[3], " -- wait a bit.");
  579.     return 1;
  580.   else
  581.     this.busy = {time() + (60 * 5), args[1], player.name, task_id()};
  582.     return 0;
  583.   endif
  584. else
  585.   this.busy = 0;
  586.   return 0;
  587. endif
  588. .
  589.  
  590. @verb #22222:"match_choice" this none this
  591. @program #22222:match_choice
  592. "match_choice(input string)";
  593. "returns the index of the choice, or 0.";
  594. "is noisy.";
  595. if (this:_textp())
  596.   player:tell($string_utils:pronoun_sub("%T is looking at a text node and has no choices."));
  597.   return 0;
  598. endif
  599. input = args[1];
  600. which = $code_utils:tonum(input);
  601. len = length(value = this.value);
  602. if (typeof(which) == NUM)
  603.   if ((which < 1) || (which > len))
  604.     player:tell("Sorry, ", input, " isn't a number between 1 and ", len, ".");
  605.     return 0;
  606.   endif
  607.   return which;
  608. else
  609.   exact = (partial = {});
  610.   for choice in [1..len]
  611.     valchoice = value[choice][2..index(value[choice], "    ") - 1];
  612.     if (input == valchoice)
  613.       exact = {@exact, choice};
  614.     elseif (index(valchoice, input) == 1)
  615.       partial = {@partial, choice};
  616.     endif
  617.   endfor
  618.   if (length(exact) > 1)
  619.     player:tell("I'm not sure whether you meant ", $string_utils:english_list(exact, "", " or "), ".");
  620.     return 0;
  621.   elseif (exact)
  622.     return exact[1];
  623.   elseif (length(partial) > 1)
  624.     player:tell("I'm not sure whether you meant ", $string_utils:english_list(partial, "", " or "), ".");
  625.     return 0;
  626.   elseif (partial)
  627.     return partial[1];
  628.   else
  629.     player:tell("Sorry, there is no choice named ", $string_utils:print(input), ".");
  630.     return 0;
  631.   endif
  632. endif
  633. .
  634.  
  635. @verb #22222:"jump goto" any on this rxd
  636. @program #22222:jump
  637. "goto <host> [socket] on slate";
  638. "  given an explicit host name and optional socket, attempt to open a";
  639. "  gopher connection to that socket";
  640. words = $string_utils:words(dobjstr);
  641. if (!words)
  642.   player:tell("Usage:  ", verb, " <host> [socket]", prepstr ? tostr(" on ", iobjstr) | "");
  643.   return;
  644. endif
  645. host = words[1];
  646. socket = 70;
  647. if (length(words) > 1)
  648.   socket = tonum(words[2]);
  649.   if (socket < 3)
  650.     player:tell("The value '", words[2], "' is not a valid socket.");
  651.     return;
  652.   endif
  653. endif
  654. path = "";
  655. if (length(words) > 2)
  656.   path = dobjstr[(index(dobjstr, words[2]) + length(words[2])) + 1..length(dobjstr)];
  657. endif
  658. if (this:busy(tostr("jumping to ", host, " socket ", socket)))
  659.   return;
  660. endif
  661. this:announce_op(tostr("%N %<jumps> to ", host, " socket ", socket, path ? " " | "", path, " on the %t."));
  662. parse = {host, socket, path, "1<jump>"};
  663. this:set_pointer(parse, @this:_textp() ? listdelete(this.stack, 1) | this.stack);
  664. this:busy(0);
  665. .
  666.  
  667. @verb #22222:"details" any on this rxd
  668. @program #22222:details
  669. if (!(which = this:match_choice(dobjstr)))
  670.   "match_choice took care of it.";
  671.   return;
  672. endif
  673. parse = $gopher:parse(this.value[which]);
  674. sel = parse[4];
  675. if (sel)
  676.   for x in ({"Type=" + sel[1], "Name=" + sel[2..length(sel)], "Path=" + parse[3], "Host=" + parse[1], "Port=" + tostr(parse[2]), "#"})
  677.     player:tell(x);
  678.   endfor
  679. else
  680.   player:tell("**** ERROR, ", which, " is not a valid entry.");
  681. endif
  682. .
  683.  
  684. @verb #22222:"set_pointer" this none this rx
  685. @program #22222:set_pointer
  686. if (!args)
  687.   value = this.remembered;
  688. else
  689.   value = $gopher:get(@args[1]);
  690. endif
  691. if (!value)
  692.   this:busy(0);
  693.   this:announce_op($gopher:interpret_error(value));
  694.   return 0;
  695. endif
  696. if (value[1][1] == "3")
  697.   this:busy(0);
  698.   this:announce_op("The gopher request results in an error:");
  699.   for x in (value)
  700.     this:announce_op(": ", x ? x[2..length(x)] | x);
  701.   endfor
  702.   return 0;
  703. endif
  704. if (args && (args[1][4][1] == "0"))
  705.   "text node";
  706.   desc = value;
  707. else
  708.   desc = {};
  709.   cnt = 1;
  710.   for x in (value)
  711.     $command_utils:suspend_if_needed(0);
  712.     type = $gopher:type(x[1]);
  713.     if (type == "text")
  714.       type = "";
  715.     else
  716.       type = ((" (" + type) + ")");
  717.     endif
  718.     tab = index(x, "    ");
  719.     label = x[2..tab - 1];
  720.     desc = {@desc, tostr(cnt, ". ", label, type)};
  721.     cnt = (cnt + 1);
  722.   endfor
  723. endif
  724. $command_utils:suspend_if_needed(0);
  725. this.desclines = desc;
  726. this.stack = args;
  727. this.value = value;
  728. this:busy(0);
  729. this:show_results();
  730. return 1;
  731. .
  732.  
  733. @verb #22222:"do_pick" this none this
  734. @program #22222:do_pick
  735. "do_pick(host, port, path, string) -- take parsed output & interact with user as appropriate.";
  736. string = args[4];
  737. if ((!string) || index("1?", type = string[1]))
  738.   "menu";
  739.   this:set_pointer(args, @this.stack);
  740. elseif (type == "7")
  741.   player:tell("Search for what? Enter search line or @abort:");
  742.   search = read();
  743.   if (search != "@abort")
  744.     this:announce_op("%N %<searches> for ", search, " on %t.");
  745.     this:set_pointer({args[1], args[2], (args[3] + "    ") + search, args[4]}, @this.stack);
  746.   else
  747.     this:busy(0);
  748.     this:announce_op("%N %<decides> not to search.");
  749.   endif
  750. elseif (type == "3")
  751.   this:busy(0);
  752.   this:announce_op("%N chose an error line.");
  753. elseif (type == "0")
  754.   "slates can point at text nodes";
  755.   this:set_pointer(args, @this.stack);
  756. elseif (type == "2")
  757.   search = $command_utils:read("one of 'name=<name>' 'phone=<phone>' 'email=<email>'");
  758.   if (!match(search, "[a-z]+=[a-z0-9@-]+"))
  759.     this:busy(0);
  760.     player:tell((search == "@abort") ? "No search." | ("Invalid query: " + search));
  761.     return;
  762.   endif
  763.   this:announce_op("%N %<searches> for ", search, " on %t.");
  764.   this:set_pointer({args[1], args[2], (args[3] + "    query ") + search, args[4]}, @this.stack);
  765. elseif ($object_utils:has_property(player, "gopher_local") && player.gopher_local)
  766.   this:busy(0);
  767.   notify(player, tostr("#$# gopher    ", args[1], "    ", args[2], "    ", args[4], "    ", args[3]));
  768. else
  769.   this:busy(0);
  770.   this:announce_op("Type ", type, " (", $gopher:type(type), ") gopher requests not implemented.");
  771.   if (type == "8")
  772.     player:tell("**** telnet ", args[1], (args[2] in {23, 0}) ? "" | (" " + tostr(args[2])));
  773.     if (args[3])
  774.       player:tell("     log in as: ", args[3]);
  775.     endif
  776.   endif
  777. endif
  778. .
  779.  
  780. @verb #22222:"remember" any on this rxd
  781. @program #22222:remember
  782. "remember <entry/here> on <this>";
  783. "  add the entry (or this menu) to the 'remembered set' for this room.";
  784. "  use 'remembered' to retrieve the set.";
  785. if (!this.stack)
  786.   return player:tell("Sorry, remembering remembered nodes doesn't work.");
  787. endif
  788. if (dobjstr == "")
  789.   parse = this.stack[1];
  790.   desc = "the current menu";
  791. elseif (choice = this:match_choice(dobjstr))
  792.   parse = $gopher:parse(this.value[choice]);
  793.   desc = this.desclines[choice];
  794. else
  795.   "Match_choice took care of it.";
  796.   return;
  797. endif
  798. parse[4] = (parse[4][1] + $command_utils:read("description for " + desc));
  799. this.remembered = {@this.remembered, $gopher:unparse(@parse)};
  800. this:announce_op("%N %<remembers> ", desc, " on the %t as ", parse[4][2..length(parse[4])], ".");
  801. .
  802.  
  803. @verb #22222:"forget delete" any on this rxd
  804. @program #22222:forget
  805. "forget <entry> on slate";
  806. "  erase an entry from the 'remembered set'";
  807. "  only works if you're looking at the 'remembered set'";
  808. if (this.stack)
  809.   player:tell("You're not looking at the top.");
  810.   return;
  811. endif
  812. if (!(choice = this:match_choice(dobjstr)))
  813.   return;
  814. endif
  815. this:announce_op("%N %<forgets> '", this.desclines[choice], "' on the %t.");
  816. this.remembered = listdelete(this.remembered, choice);
  817. this:set_pointer();
  818. .
  819.  
  820. @verb #22222:"look_self" this none this
  821. @program #22222:look_self
  822. if (this.stack)
  823.   sum = $gopher:summary(this.stack[1]);
  824.   player:tell(this:titlec(), ": ", sum[1], " ", sum[2]);
  825. else
  826.   player:tell(this:titlec());
  827. endif
  828. player:tell_lines(this:description());
  829. this:_tell_desc();
  830. state = "";
  831. if (valid(this.controlled))
  832.   state = (($string_utils:pronoun_sub("The %t is being controlled by ") + this.controlled:title()) + ".");
  833. endif
  834. if ((busy = this:_is_busy()) || state)
  835.   player:tell(state ? state + " " | "", busy ? $string_utils:pronoun_sub(tostr("The %t is busy ", this.busy[2], " for ", this.busy[3], ".")) | "");
  836. endif
  837. .
  838.  
  839. @verb #22222:"_tell_desc" this none this
  840. @program #22222:_tell_desc
  841. who = (args ? args[1] | player);
  842. plen = ((length(args) > 1) ? args[2] | this.length);
  843. header = ((length(args) > 2) && args[3]);
  844. if (this:_textp())
  845.   text = this:text();
  846.   len = length(text);
  847.   if ((!plen) || (len <= plen))
  848.     $command_utils:suspend_if_needed(0);
  849.     "6/24/93 change tell_lines to notify_lines to reduce lag.";
  850.     if (header)
  851.       who:tell("--------------- ", this.name, "-----");
  852.       who:notify_lines(text);
  853.       who:tell("--------------- ", this.name, "-----");
  854.     else
  855.       who:notify_lines(text);
  856.     endif
  857.     return;
  858.   endif
  859.   offset = this:offset();
  860.   npages = ((len / plen) + 1);
  861.   thispage = ((offset / plen) + 1);
  862.   if ((offset != 1) || header)
  863.     who:tell("--", thispage, " of ", npages, "----- 'prev on ", this.name, "' for previous----");
  864.   endif
  865.   end = ((offset + plen) - 1);
  866.   who:tell_lines(text[offset..min(len, end)]);
  867.   if ((len > end) || header)
  868.     who:tell("--", thispage, " of ", npages, "----- 'next on ", this.name, "' for more --------");
  869.   endif
  870.   return;
  871. endif
  872. this.seen = setadd(this.seen, {who, @this:_place()});
  873. len = length(this.desclines);
  874. if (header)
  875.   who:tell("--------------- ", this.name, "-----");
  876. endif
  877. if (plen && (len > plen))
  878.   offset = this:offset();
  879.   who:tell_lines(this.desclines[offset..min((offset + this.length) - 1, len)]);
  880.   nxt = ("next on " + this.name);
  881.   prv = ("previous on " + this.name);
  882.   who:tell("---- '", (offset == 1) ? nxt | (((offset + plen) > len) ? prv | (((("'" + nxt) + "' or '") + prv) + "'")), "' to see additional choices (", len, " total) ---");
  883. else
  884.   who:tell_lines(this.desclines || {$string_utils:pronoun_sub("%T is empty right now.")});
  885.   if (header)
  886.     who:tell("--------------- ", this.name, "-----");
  887.   endif
  888. endif
  889. .
  890.  
  891. @verb #22222:"next prev*ious" any on this rxd
  892. @program #22222:next
  893. if (this:busy("reading"))
  894.   "can't 'next' if it is busy";
  895.   return;
  896. endif
  897. this:busy(0);
  898. n = (tonum(dobjstr) || 1);
  899. if (verb != "next")
  900.   n = (-n);
  901.   verb = "previous";
  902. endif
  903. offset = this:offset();
  904. new = (offset + (n * this.length));
  905. if (new < 1)
  906.   if (offset == 1)
  907.     return player:tell("You're already at the beginning.");
  908.   else
  909.     new = 1;
  910.   endif
  911. elseif (new > length(this.desclines))
  912.   return player:tell("You're already at the end.");
  913. endif
  914. this:announce_op("%N %<looks> at the ", verb, " ", this:_textp() ? "page" | "results", " on the %t.");
  915. this:offset(new);
  916. this:show_results();
  917. .
  918.  
  919. @verb #22222:"initialize" this none this
  920. @program #22222:initialize
  921. if ((caller == this) || $perm_utils:controls(caller_perms(), this))
  922.   "don't call this unless you mean it.";
  923.   this.seen = {};
  924.   this.desclines = {};
  925.   "The default is that slate's inherit the 'remembered' from their parent. This means, though, that they're initially blank but have to be 'reset' to fire up. See :do_reset";
  926.   "this.remembered = {}";
  927.   this.busy = 0;
  928.   this.stack = {};
  929.   this.watching = {};
  930.   this.controlled = #-1;
  931.   pass(@args);
  932. endif
  933. .
  934.  
  935. @verb #22222:"announce_op" this none this
  936. @program #22222:announce_op
  937. msg = tostr(@args);
  938. player:tell($string_utils:pronoun_sub(msg, $you));
  939. if (this.location != player)
  940.   this.location:announce($string_utils:pronoun_sub(msg));
  941. endif
  942. return;
  943. "announcing only to watching";
  944. if (watching = setremove($set_utils:intersection(this.watching, this.location:contents()), player))
  945.   msg = $string_utils:pronoun_sub(msg);
  946.   for x in (watching)
  947.     x:tell(msg);
  948.   endfor
  949. endif
  950. .
  951.  
  952. @verb #22222:"_place" this none this
  953. @program #22222:_place
  954. return this.stack && this.stack[1][1..3];
  955. .
  956.  
  957. @verb #22222:"_textp" this none this
  958. @program #22222:_textp
  959. return this.stack && index("02", this.stack[1][4][1]);
  960. .
  961.  
  962. @verb #22222:"r*ead" any any any rxd
  963. @program #22222:read
  964. if ((!argstr) || ((dobj == this) && (!prepstr)))
  965.   this:_tell_desc(player, 0);
  966. elseif (which = this:match_choice((($code_utils:short_prep(prepstr) == "on") && (iobj == this)) ? dobjstr | argstr))
  967.   where = $gopher:parse(this.value[which]);
  968.   if (index("02", where[4][1]))
  969.     this:announce_op("%N %<reads> '", this.desclines[which], "' on the %t.");
  970.     $gopher:show_text(player, 0, 0, @where);
  971.     player:tell("-------");
  972.   else
  973.     player:tell("Item '", this.desclines[which], "' isn't text and can't be read.");
  974.   endif
  975. else
  976.   player:tell("Read what?");
  977. endif
  978. .
  979.  
  980. @verb #22222:"lock unlock" this none none rxd
  981. @program #22222:lock
  982. this.locked = (verb == "lock");
  983. this:announce_op("%N %<", $string_utils:lowercase(verb), "s> %t.");
  984. .
  985.  
  986. @verb #22222:"text" this none this
  987. @program #22222:text
  988. return this.value;
  989. "don't update slates";
  990. .
  991.  
  992. @verb #22222:"update" this none none rxd
  993. @program #22222:update
  994. if (this:busy("updating", 1))
  995.   return;
  996. endif
  997. this:announce_op("%N %<updates> %t.");
  998. if (this.stack)
  999.   $gopher:clear_cache(@this.stack[1]);
  1000. endif
  1001. this:set_pointer(@this.stack);
  1002. .
  1003.  
  1004. @verb #22222:"_mail_text" this none this
  1005. @program #22222:_mail_text
  1006. if (this:_textp())
  1007.   return this.value;
  1008. else
  1009.   text = {};
  1010.   for x in (this.value)
  1011.     parse = $gopher:parse(x);
  1012.     sel = parse[4];
  1013.     text = {@text, "Type=" + sel[1], "Name=" + sel[2..length(sel)], "Path=" + parse[3], "Host=" + parse[1], "Port=" + tostr(parse[2]), "#"};
  1014.   endfor
  1015.   return text;
  1016. endif
  1017. .
  1018.  
  1019. @verb #22222:"show_results" this none this
  1020. @program #22222:show_results
  1021. "after a selection is made, this verb is used to show the results; usually to 'player'";
  1022. inhere = ($object_utils:isa(this.location, $room) ? this.location:contents() | {player});
  1023. for x in (this.watching = setadd(this.watching, player))
  1024.   $command_utils:suspend_if_needed(0);
  1025.   if (x in inhere)
  1026.     this:_tell_desc(x, this.length, player != x);
  1027.   else
  1028.     this.watching = setremove(this.watching, x);
  1029.   endif
  1030. endfor
  1031. .
  1032.  
  1033. @verb #22222:"ignore watch" this none none rxd
  1034. @program #22222:ignore
  1035. was = (player in this.watching);
  1036. this.watching = ((verb == "watch") ? setadd(this.watching, player) | setremove(this.watching, player));
  1037. is = (player in this.watching);
  1038. if (was == is)
  1039.   player:tell("You already were ", (verb == "watch") ? "watching" | "ignoring", " ", this:title(), ".");
  1040. elseif (this.location == player)
  1041.   player:tell("You start to ", verb, " ", this:title(), ".");
  1042. else
  1043.   $you:say_action(("%N %<starts> to " + verb) + " %t.");
  1044. endif
  1045. .
  1046.  
  1047. @verb #22222:"show" this to any rxd
  1048. @program #22222:show
  1049. if (!valid(iobj))
  1050.   return player:tell("I don't see '", iobjstr, "' here.");
  1051. endif
  1052. $you:say_action("%N %<shows> %t to %i.");
  1053. this:_tell_desc(iobj, this.length, 1);
  1054. .
  1055.  
  1056. @verb #22222:"_is_busy" this none this
  1057. @program #22222:_is_busy
  1058. if (this.busy)
  1059.   if (this.busy[1] > time())
  1060.     return 1;
  1061.   else
  1062.     this.busy = 0;
  1063.   endif
  1064. endif
  1065. return 0;
  1066. .
  1067.  
  1068. @verb #22222:"control" this none none rxd
  1069. @program #22222:control
  1070. if (this.controlled == player)
  1071.   player:tell("You are already controlling ", this:title(), ".");
  1072.   return;
  1073. endif
  1074. from = (valid(this.controlled) ? (" from " + this.controlled:title()) + "." | ".");
  1075. if (this.location != player)
  1076.   this.location:announce_all_but({player}, $string_utils:pronoun_sub("%N takes the controls of %t"), from);
  1077. endif
  1078. player:tell("You take the controls of ", this:title(), from);
  1079. this.controlled = player;
  1080. .
  1081.  
  1082. @verb #22222:"release" this none none rxd
  1083. @program #22222:release
  1084. if (this.controlled == player)
  1085.   $you:say_action("%N %<releases> the controls of %t.");
  1086.   this.controlled = #-1;
  1087. else
  1088.   player:tell("You weren't holding the controls of ", this.name, ".");
  1089. endif
  1090. .
  1091.  
  1092. @verb #22222:"is_locked" this none this
  1093. @program #22222:is_locked
  1094. "is this locked?";
  1095. if (this.locked)
  1096.   return "locked";
  1097. elseif (valid(this.controlled) && (this.controlled != args[1]))
  1098.   if (this.location in {this.controlled, this.controlled.location})
  1099.     return "controlled by " + this.controlled.name;
  1100.   else
  1101.     this.controlled = #-1;
  1102.   endif
  1103. endif
  1104. return 0;
  1105. .
  1106.  
  1107. @verb #22222:"match_command" this none this rx
  1108. @program #22222:match_command
  1109. "match_command(vrb, dlist, plist, ilist)";
  1110. "return true if this object can handle the command, false otherwise";
  1111. "vrb - name of the verb the player typed";
  1112. "dlist - list of objspecs that this command matches";
  1113. "plist and ilist - likewise for prepspecs, iobjspecs";
  1114. if ((player.focus_object == this) && (this.location in {player, player.location}))
  1115.   vrb = args[1];
  1116.   dlist = args[2];
  1117.   plist = args[3];
  1118.   ilist = args[4];
  1119.   if (((vrb in {"pick", "jump", "goto", "details", "remember", "forget", "delete", "next", "prev", "previ", "previo", "previou", "previous"}) && ("none" in plist)) && ("none" in ilist))
  1120.     return 1;
  1121.   elseif (((vrb in {"read", "ignore", "watch"}) && ("none" in dlist)) && ("none" in plist))
  1122.     return 1;
  1123.   elseif (((vrb in {"show"}) && ("none" in dlist)) && ("at/to" in plist))
  1124.     return 1;
  1125.   elseif ((vrb in {"reset", "stack", "mailme", "lock", "unlock", "update", "control", "release"}) && (!("on top of/on/onto/upon" in plist)))
  1126.     return 1;
  1127.   elseif (((vrb in {"pop", "back"}) && ("none" in dlist)) && (("none" in plist) || ("for/about" in plist)))
  1128.     return 1;
  1129.   endif
  1130. endif
  1131. return pass(@args);
  1132. .
  1133.  
  1134. @verb #22222:"work" none with this r
  1135. @program #22222:work
  1136. "This is a JaysHouseMOO verb -- probably doesn't work on other MOOs without a 'focus' object.";
  1137. if (valid(player:set_focus_object(this)))
  1138.   $you:say_action(this.work_with_msg);
  1139. else
  1140.   player:tell("You just can't seem to focus on that.");
  1141. endif
  1142. .
  1143.  
  1144. @verb #22222:"mailme" any any any rxd
  1145. @program #22222:mailme
  1146. "mailme note";
  1147. if ((caller_perms() != player) && (caller != player))
  1148.   return player:tell("Someone tried to mail you some text, but it didn't work.");
  1149. endif
  1150. if (!player.email_address)
  1151.   return player:tell("Sorry, you don't have a registered email address.");
  1152. endif
  1153. if ((!argstr) || ((dobj == this) && (!prepstr)))
  1154.   where = this.stack[1];
  1155. elseif (which = this:match_choice((($code_utils:short_prep(prepstr) == "on") && (iobj == this)) ? dobjstr | argstr))
  1156.   where = $gopher:parse(this.value[which]);
  1157. endif
  1158. if (where)
  1159.   player:tell("Mailing ", this:location_string(where), " to ", player.email_address, ".");
  1160.   text = $gopher:_mail_text(where);
  1161.   player:tell("... ", length(text), " lines ...");
  1162.   text = {tostr("(Mail initiated by ", player.name, " (", player, ") connected from ", $string_utils:connection_hostname(connection_name(player)), " using ", this.name, ")"), @text};
  1163.   suspend(0);
  1164.   result = $network:sendmail(player.email_address, this:location_string(where), @text);
  1165.   if (result == 0)
  1166.     player:tell("Mail sent successfully.");
  1167.   else
  1168.     player:tell("Mail sending error: ", result, ".");
  1169.   endif
  1170. else
  1171.   player:tell("Sorry, can't mail this.");
  1172. endif
  1173. .
  1174.  
  1175. @verb #22222:"header" this none this
  1176. @program #22222:header
  1177. "used by _tell_desc for prefix & suffix lines";
  1178. args[1]:tell("------- ", $string_utils:left($string_utils:pronoun_sub(tostr(@listdelete(args, 1), " ")), args[1]:linelen(), "-"));
  1179. .
  1180.  
  1181. @verb #22222:"offset" this none this
  1182. @program #22222:offset
  1183. if (!this.stack)
  1184.   return 1;
  1185. endif
  1186. menu = this.stack[1];
  1187. if (args)
  1188.   if (length(menu) > 4)
  1189.     this.stack[1][5] = args[1];
  1190.   else
  1191.     this.stack[1] = {@{@menu, "", "", "", ""}[1..4], args[1]};
  1192.   endif
  1193. elseif (length(menu) > 4)
  1194.   return menu[5];
  1195. else
  1196.   return 1;
  1197. endif
  1198. .
  1199.  
  1200. "***finished loading gopher slate ***
  1201. @prop #0.network #33333 "r"
  1202. @prop #33333."site" "lambda.parc.xerox.com" r
  1203. "Change $network.site to your site
  1204. @prop #33333."large_domains" {} r
  1205. @prop #33333."open_connections" {} r
  1206. @prop #33333."connect_connections_to" {} r
  1207. @prop #33333."postmaster" "lambdamoo-registration@parc.xerox.com" rc
  1208. "Set $network.postmaster to your email address
  1209. @prop #33333."port" 8888 rc
  1210. "Set $network.port to the MOO port number
  1211. @prop #33333."MOO_name" "LambdaMOO" rc
  1212. "Set $network.MOO_Name to the name of the MOO
  1213. @prop #33333."valid_host_regexp" "^%([-a-z0-9]+%.%)+%(gov%|edu%|com%|org%|int%|mil%|net%|%nato%|arpa%|[a-z][a-z]%)$" rc
  1214. @prop #33333."maildrop" "sandbox.xerox.com" rc
  1215. @prop #33333."trusts" {} r
  1216. @prop #33333."reply_address" "moomail@sandbox.xerox.com" rc
  1217. "set $network.reply_address to return address for mail back to the MOO
  1218. @prop #33333."active" 1 r
  1219. @prop #33333."valid_email_regexp" "^[-a-z0-9_!.]+$" rc
  1220. @prop #33333."invalid_userids" {} r
  1221. ;#33333.("invalid_userids") = {"", "sysadmin", "root", "postmaster", "system", "operator", "bin"}
  1222. @prop #33333."debugging" 0 rc
  1223. ;#33333.("description") = {"Utilities for dealing with network connections", "---------------", "Creating & tracking hosts:", "", ":open(host, port [, connect-connection-to]) => {connection, object}", "    open a network connection (using open_network_connection), optionally", "    allows for it to be connected to another object.", "    (see #0:do_login_command for details).", "", ":close(connection)", "     closes the connection & cleans up data", "", "------------------", "Parsing network things:", "", ":invalid_email_address(email)", "     return \"\" or string saying why 'email' is invalid.", "     uses .valid_email_regexp", "", ":invalid_hostname(host)", "     return \"\" or string saying why 'host' doesn't look", "     like a valid internet host name", "", ":local_domain(host)", "     returns the 'important' part of a host name, e.g.", "     golden.parc.xerox.com => parc.xerox.com", "", "-------------------", "Sending mail", "", ":sendmail(to, subject, @lines)", "     send mail to the email address 'to' with indicated subject.", "     header fields like 'from', 'date', etc. are filled in.", "     lines can start with additional header lines.", "", ":raw_sendmail(to, @lines)", "     used by :sendmail. Send mail to given user at host, just", "     as specified, no error checking.", "", "================================================================", "Parameters:", "", ".active If 0, disabled sending of mail.", "", ".site   Where does this MOO run?", "        (Maybe MOOnet will use it later).", "", ".port   The network port this MOO listens on.", "", ".large_domains ", "        A list of sites where more than 2 levels of host name are", "        significant, e.g., if you want 'parc.xerox.com' to be", "        different than 'cinops.xerox.com', put \"xerox.com\" as an", "        element in .large_domains.", "", ".postmaster", "        Email address to which problems with MOO mail should", "        go. This should be a real email address that someone reads.", "", ".maildrop", "        Hostname to connect to for dropping off mail. Usually can", "        just be \"localhost\".", "", ".reply_address", "        If a MOO character sends email, where does a reply go?", "        Inserted in 'From:' for mail from characters without", "        registration addresses.        ", "", ".trusts", "        List of (non-wizard) programmers who can call", "        :open, :sendmail, :close", "", "                "}
  1224. ;#33333.("object_size") = {11843, 741006149}
  1225.  
  1226. @verb #33333:"parse_address" this none this
  1227. @program #33333:parse_address
  1228. "Given an email address, return {userid, site}.";
  1229. "Valid addresses are of the form `userid[@site]'.";
  1230. "At least for now, if [@site] is left out, site will be returned as blank.";
  1231. "Should be a default address site, or something, somewhere.";
  1232. address = args[1];
  1233. return (at = index(address, "@")) ? {address[1..at - 1], address[at + 1..length(address)]} | {address, ""};
  1234. .
  1235.  
  1236. @verb #33333:"local_domain" this none this
  1237. @program #33333:local_domain
  1238. "given a site, try to figure out what the `local' domain is.";
  1239. "if site has a @ or a % in it, give up and return E_INVARG.";
  1240. "blank site is returned as is; try this:local_domain(this.localhost) for the answer you probably want.";
  1241. site = args[1];
  1242. if (index(site, "@") || index(site, "%"))
  1243.   return E_INVARG;
  1244. elseif (match(site, "^[0-9.]+$"))
  1245.   return E_INVARG;
  1246. elseif (!site)
  1247.   return "";
  1248. elseif (!(dot = rindex(site, ".")))
  1249.   dot = rindex(site = this.site, ".");
  1250. endif
  1251. if ((!dot) || (!(dot = rindex(site[1..dot - 1], "."))))
  1252.   return site;
  1253. else
  1254.   domain = site[dot + 1..length(site)];
  1255.   site = site[1..dot - 1];
  1256.   while (site && (domain in this.large_domains))
  1257.     if (dot = rindex(site, "."))
  1258.       domain = tostr(site[dot + 1..length(site)], ".", domain);
  1259.       site = site[1..dot - 1];
  1260.     else
  1261.       return tostr(site, ".", domain);
  1262.     endif
  1263.   endwhile
  1264.   return domain;
  1265. endif
  1266. .
  1267.  
  1268. @verb #33333:"open" this none this rx
  1269. @program #33333:open
  1270. ":open(address, port, [connect-connection-to])";
  1271. "Open a network connection to address/port.  If the connect-connection-to is passed, then the connection will be connected to that object when $login gets ahold of it.  If not, then the connection is just ignored by $login, i.e. not bothered by it with $welcome_message etc.";
  1272. "The object specified by connect-connection-to has to be a player (though it need not be a $player).";
  1273. "Returns the (initial) connection or an error, as in open_network_connection";
  1274. if (!this:trust(forwhom = caller_perms()))
  1275.   return E_PERM;
  1276. endif
  1277. address = args[1];
  1278. port = args[2];
  1279. if (length(args) < 3)
  1280.   connect_to = $nothing;
  1281. elseif ((typeof(connect_to = args[3]) == OBJ) && (valid(connect_to) && is_player(connect_to)))
  1282. else
  1283.   return E_INVARG;
  1284. endif
  1285. if (typeof(connection = open_network_connection(address, port)) != ERR)
  1286.   this.open_connections = {@this.open_connections, connection};
  1287.   if (valid(connect_to))
  1288.     this.connect_connections_to = {@this.connect_connections_to, {connection, connect_to}};
  1289.   endif
  1290. endif
  1291. return connection;
  1292. .
  1293.  
  1294. @verb #33333:"close" this none this rx
  1295. @program #33333:close
  1296. if (!this:trust(caller_perms()))
  1297.   return E_PERM;
  1298. endif
  1299. boot_player(args[1]);
  1300. $login.ignored = setremove($login.ignored, args[1]);
  1301. $network.open_connections = setremove($network.open_connections, args[1]);
  1302. if (i = $list_utils:iassoc(args[1], $network.connect_connections_to))
  1303.   $network.connect_connections_to = listdelete($network.connect_connections_to, i);
  1304. endif
  1305. return 1;
  1306. .
  1307.  
  1308. @verb #33333:"sendmail" any none none rxd
  1309. @program #33333:sendmail
  1310. "sendmail(to, subject, @lines)";
  1311. "  sends mail to internet address 'to', with given subject.";
  1312. "  It fills in various fields, such as date, from (from player), etc.";
  1313. "  lines are remaining lines of the message, and may begin with additional header fields.";
  1314. "  (must match RFC822 specification).";
  1315. "Requires $network.trust to call (no anonymous mail from MOO).";
  1316. "Returns 0 if successful, or else error condition or string saying why not.";
  1317. if (!this:trust(caller_perms()))
  1318.   return E_PERM;
  1319. endif
  1320. mooname = this.MOO_name;
  1321. mooinfo = tostr(mooname, " (", this.site, " ", this.port, ")");
  1322. if (reason = this:invalid_email_address(to = args[1]))
  1323.   return reason;
  1324. endif
  1325. return this:raw_sendmail(to, "Date: " + ctime(), ((((("From: \"" + player.name) + "@") + mooname) + "\" <") + this.reply_address) + ">", "To: " + to, "Subject: " + args[2], "X-Mail-Agent: " + mooinfo, @args[3..length(args)]);
  1326. .
  1327.  
  1328. @verb #33333:"trust" this none this
  1329. @program #33333:trust
  1330. return (who = args[1]).wizard || (who in this.trusts);
  1331. .
  1332.  
  1333. @verb #33333:"init_for_core" this none this
  1334. @program #33333:init_for_core
  1335. if (caller_perms().wizard)
  1336.   pass(@args);
  1337.   this.active = 0;
  1338.   this.reply_address = "moomailreplyto@yourhost";
  1339.   this.site = "yoursite";
  1340.   this.postmaster = "postmastername@yourhost";
  1341.   this.MOO_name = "YourMOO";
  1342.   this.maildrop = "localhost";
  1343.   this.port = 7777;
  1344.   this.large_domains = {};
  1345.   this.trusts = {};
  1346.   this.open_connections = (this.connect_connections_to = {});
  1347. endif
  1348. .
  1349.  
  1350. @verb #33333:"raw_sendmail" any none none rx
  1351. @program #33333:raw_sendmail
  1352. "rawsendmail(to, @lines)";
  1353. "sends mail without processing. Returns 0 if successful, or else reason why not.";
  1354. if (!caller_perms().wizard)
  1355.   return E_PERM;
  1356. endif
  1357. if (!this.active)
  1358.   return "Networking is disabled.";
  1359. endif
  1360. debugging = this.debugging;
  1361. address = args[1];
  1362. body = listdelete(args, 1);
  1363. data = {"HELO " + this.site, ("MAIL FROM:<" + this.postmaster) + ">", ("RCPT TO:<" + address) + ">", "DATA"};
  1364. blank = 0;
  1365. for x in (body)
  1366.   $command_utils:suspend_if_needed(0);
  1367.   if (!(blank || match(x, "[a-z0-9-]*: ")))
  1368.     if (x)
  1369.       data = {@data, ""};
  1370.     endif
  1371.     blank = 1;
  1372.   endif
  1373.   data = {@data, (x == ".") ? "." + x | x};
  1374. endfor
  1375. data = {@data, ".", "QUIT", ""};
  1376. suspend(0);
  1377. target = $network:open(this.maildrop, 25);
  1378. if (typeof(target) == ERR)
  1379.   return tostr("Cannot open connection to maildrop ", this.maildrop, ": ", target);
  1380. endif
  1381. fork (0)
  1382.   for line in (data)
  1383.     $command_utils:suspend_if_needed(0);
  1384.     if (debugging)
  1385.       notify(this.owner, "SEND:" + line);
  1386.     endif
  1387.     notify(target, line);
  1388.   endfor
  1389. endfork
  1390. expect = {"2", "2", "2", "2", "3", "2"};
  1391. while (expect && (typeof(line = read(target)) != ERR))
  1392.   if (line)
  1393.     if (debugging)
  1394.       notify(this.owner, "GET: " + line);
  1395.     endif
  1396.     if (!index("23", line[1]))
  1397.       $network:close(target);
  1398.       return line;
  1399.       "error return";
  1400.     else
  1401.       if (line[1] != expect[1])
  1402.         expect = {@expect, "2", "2", "2", "2", "2"};
  1403.       else
  1404.         expect = listdelete(expect, 1);
  1405.       endif
  1406.     endif
  1407.   endif
  1408. endwhile
  1409. $network:close(target);
  1410. return 0;
  1411. .
  1412.  
  1413. @verb #33333:"invalid_email_address" this none this
  1414. @program #33333:invalid_email_address
  1415. "invalid_email_address(email) -- check to see if email looks like a valid email address. Return reason why not.";
  1416. address = args[1];
  1417. if (!(at = rindex(address, "@")))
  1418.   return ("'" + address) + "' contains no @";
  1419. endif
  1420. name = address[1..at - 1];
  1421. host = address[at + 1..length(address)];
  1422. if (!match(host, $network.valid_host_regexp))
  1423.   return tostr("'", host, "' doesn't look like a valid internet host");
  1424. endif
  1425. if (!match(name, $network.valid_email_regexp))
  1426.   return tostr("'", name, "' doesn't look like a valid user name for internet mail");
  1427. endif
  1428. return "";
  1429. .
  1430.  
  1431. @verb #33333:"invalid_hostname" this none this
  1432. @program #33333:invalid_hostname
  1433. return match(args[1], this.valid_host_regexp) ? "" | tostr("'", args[1], "' doesn't look like a valid internet host name");
  1434. .
  1435.  
  1436. "***finished***
  1437.